تمرین سری چهارم: چقدر ریاضی بلدیم و چرا؟
لطفا مقاله زیر را مطالعه بفرمایید.
چرایی رتبه ضعیف ایران در آزمون تیمز
با استفاده از داده های ارزیابی تیمز ۲۰۱۵ ادعاهای زیر را مورد ارزیابی قراردهید. برای هر سوال علاوه بر استدلال آماری که در غالب آزمون فرض تعریف می شود از تصویرسازی مناسب باهر دو ابزار ggplot2 و highcharter استفاده نمایید. به دلخواه به هفت گزاره از موارد زیر پاسخ دهید.
پیش از شروع به حل کردن متوجه می شویم که نمرات به آن گونه ای که انتظار داشته ایم برای هر سوال داده نشده اند! برای اینکه داده ها را به صورت قابل پذیرش به دست آوریم از چند تابع کمک می گیریم. البته در ادامه می بینیم که این کارها صرفا به درد سوال ۶ می خورند!
library(knitr)
library(kableExtra)
library(dplyr)
library(readr)
library(tidyr)
library(readxl)
library(ggplot2)
library(highcharter)
library(formattable)
setwd("/Users/macbook/Desktop/96-97-2/Data\ Analysis/timss15_grade_8")
read_xlsx("T15_G8_ItemInformation.xlsx", sheet = "MAT") -> info_m
read_xlsx("T15_G8_ItemInformation.xlsx", sheet = "SCI") -> info_s
info <- bind_rows(info_m, info_s)
read_xlsx("T15_G8_Codebook.xlsx", sheet = "BSA") -> CB_BSA
read_rds("data/bsa.rds") -> BSA
read_rds("data/bst.rds") -> BST
read_rds("data/bts.rds") -> BTS
read_rds("data/btm.rds") -> BTM
read_rds("data/bcg.rds") -> BCG
read_rds("data/bsg.rds") -> BSG
BSA$itsex <- replace(BSA$itsex,BSA$itsex == 1, "F")
BSA$itsex <- replace(BSA$itsex,BSA$itsex == 2, "M")
BSA$itsex <- as.factor(BSA$itsex)
left_join(x = info,
y = CB_BSA %>% rename(`Item ID` = Variable),
by = "Item ID") -> questions_info
questions_info_f <- questions_info
questions_info_f$`Value Scheme Detailed` <-
as.factor(paste(
questions_info$`Value Scheme Detailed`,
" / ",
questions_info$`Maximum Points`
))
questions_info_f$`Item ID` <- tolower(questions_info_f$`Item ID`)
questions_info_f %>%
select(`Value Scheme Detailed`) %>%
unique() %>%
arrange(`Value Scheme Detailed`) %>%
mutate(level = as.numeric(`Value Scheme Detailed`)) -> marking_scheme
questions_scheme_type <-
questions_info_f %>% select(Question = `Item ID`, `Value Scheme Detailed`)
#write_csv(marking_scheme, "../HW/HW4/Problems/hw_04/Solutions/marking_scheme.csv")
hed <- function(data) {
View(head(data, 10))
}
getMark <- function(questions, answers) {
mark <- rep(NA, length(answers))
questions_type <-
as.numeric(
left_join(questions,
questions_scheme_type,
by = "Question")$`Value Scheme Detailed`
)
full_marks <- rep(0, length(answers))
result <- mark %>%
replace(questions_type == 1 & answers == 4, 1) %>%
replace(questions_type > 1 &
questions_type <= 3 & answers == 3, 1) %>%
replace(questions_type > 3 &
questions_type <= 6 & answers == 2, 1) %>%
replace(questions_type > 6 &
questions_type <= 10 & answers == 1, 1) %>%
replace(questions_type == 1 & answers != 4, 0) %>%
replace(questions_type > 1 &
questions_type <= 3 & answers != 3, 0) %>%
replace(questions_type > 3 &
questions_type <= 6 & answers != 2, 0) %>%
replace(questions_type > 6 &
questions_type <= 10 & answers != 1, 0) %>%
replace(questions_type > 10 &
questions_type <= 23 &
answers <= 20 & answers >= 10,
1) %>%
replace(questions_type > 10 &
questions_type <= 23 &
answers <= 80 & answers >= 70,
0) %>%
replace(questions_type > 23 &
questions_type <= 27 &
answers < 20 & answers >= 10,
0.5) %>%
replace(questions_type > 23 &
questions_type <= 27 &
answers <= 22 & answers >= 20,
1) %>%
replace(questions_type > 23 &
questions_type <= 27 &
answers <= 80 & answers >= 70,
0) %>%
replace(questions_type == 28 &
answers == 10,
0.5) %>%
replace(questions_type == 28 &
answers == 20,
1) %>%
replace(questions_type == 28 &
answers == 79,
0) %>%
replace(questions_type == 29 &
answers == 10,
0.5) %>%
replace(questions_type == 29 &
answers == 20,
1) %>%
replace(questions_type == 29 &
answers == 79,
0)
weights <- left_join(questions,
questions_info_f %>% select(Question = `Item ID`, weight = `Maximum Points`),
by = "Question")$weight
ret <- data.frame(cbind(score = result, weight = weights))
ret$weight <- as.numeric(ret$weight)
ret$score <- as.numeric(ret$score)
return(ret)
}۱. میران رضایت معلمان در پیشرفت تحصیلی دانش آموزان موثر است.
برای پاسخگویی به این سوال ابتدا با جمع زدن چند شاخص رضایت شغلی معلمان معیاری کلی برای مشخص کردن سطح رضایت دست پیدا می کنیم. سپس با استفاده از کریلیشن تست و استفاده از متد اسپیرمن این ادعا را بررسی می کنیم. نتیجه ی آن هم این است که میزان رضایت معلمان با عملکرد دانش آموزان رابطه ی عکس دارد.
st <- BST %>%
select(c(idcntry:idlink))
teachersM <-
BTM %>%
mutate(sat = (28 - btbg10a + btbg10b + btbg10c + btbg10d +
btbg10e + btbg10f + btbg10g)) %>%
select(c(idcntry:idlink, sat))
teachersS <-
BTS %>%
mutate(sat = (28 - btbg10a + btbg10b + btbg10c + btbg10d +
btbg10e + btbg10f + btbg10g)) %>%
select(c(idcntry:idlink, sat))
full_join(teachersM, st) -> st_M
full_join(teachersS, st) -> st_S
bsa_m <-
BSA %>% select(idcntry:idstud, bsmmat01:bsmmat05) %>%
group_by(idcntry, idbook, idschool, idclass, idstud) %>%
summarize(score = mean(bsmmat01:bsmmat05)) %>%
ungroup()
bsa_s <-
BSA %>% select(idcntry:idstud, bsssci01:bsssci05) %>%
group_by(idcntry, idbook, idschool, idclass, idstud) %>%
summarize(score = mean(bsssci01:bsssci05)) %>%
ungroup()
full_join(st_M, bsa_m) -> sts_M
full_join(st_S, bsa_s) -> sts_S
rbind(sts_M, sts_S) %>% filter(!is.na(score)) -> sts
kable(unlist(cor.test(sts$sat, sts$score, alternative = "greater", method = "spearman")))| x | |
|---|---|
| statistic.S | 43135807519203784 |
| p.value | 4.53299399101593e-74 |
| estimate.rho | 0.022670128216608 |
| null.value.rho | 0 |
| alternative | greater |
| method | Spearman’s rank correlation rho |
| data.name | sts\(sat and sts\)score |
sts$sat <- as.character(sts$sat)
sts %>% group_by(sat) %>% summarize(mean_score = mean(score)) %>% filter(!is.na(sat)) -> sts_m
sts_m$sat <- as.numeric(sts_m$sat)
sts$sat <- as.numeric(sts$sat)
sts %>% filter(!is.na(sat), !is.na(score))%>% sample_n(5000) -> sts_sample_5000
hchart(
sts_sample_5000,
type = "scatter",
hcaes(sat, round(score, 2)),
color = hex_to_rgba(x <- "#386cb0", alpha = 0.1)
) %>%
hc_add_series(
data = sts_m,
type = "line",
hcaes(sat, round(mean_score, 2)),
color = hex_to_rgba(x <- "#fdb462", alpha = 1)
) %>%
hc_title(text = "Teachers' Satisfaction Level and Score Relation") %>%
hc_xAxis(title = list(text = "Satisfaction Level")) %>%
hc_yAxis(title = list(text = "Score")) %>%
hc_add_theme(hc_theme_sandsignika())hcboxplot( x = sts_sample_5000$score, var = sts_sample_5000$sat, outliers = F) %>%
hc_chart(type = "column") %>%
hc_title(text = "Teachers' Satisfaction Level and Score Relation") %>%
hc_xAxis(title = list(text = "Satisfaction Level")) %>%
hc_yAxis(title = list(text = "Score")) %>%
hc_add_theme(hc_theme_sandsignika())ggplot(sts %>% filter(!is.na(sat), !is.na(score)), aes(x = sat, y = score)) +
geom_boxplot(aes(group = sat, y = score, fill = sat))+
geom_line(data = sts_m, aes(x = sat, y = mean_score), color = "#fdb462")+
xlab("Satisfaction Level") +
ylab("Score") +
ggtitle("Teachers' Satisfaction Level and Score Relation")۲. والدینی که تحصیلات بیشتری دارند دارای فرزندان موفق تری می باشند.
ابتدا برای هر والد و هر فرزند یک سطر ایجاد می کنیم و میزان تحصیلات آن والد را جلوی آن می نویسیم. سپس با آنووا بررسی می کنیم که آیا تحصیلات موثر است یا نه. سپس با تی تست( از آنجایی که نمرات از توزیع نرمال پیروزی می کنند می توان از تی تست استفاده کرد.) بیشترین سطح تحصیلات را با بقیه ی سطوح و همچنین کمترین سطح تحصیلات را با بقیه ی سطوح مقایسه می کنیم و مشاهده می کنیم که سطح تحصیلات موثر است.
BSG %>%
select(idcntry:idstud, bsmmat01:bsssci05 , bsbg07a, bsbg07b) %>%
mutate(
score = (
bsmmat01 + bsmmat02 + bsmmat03 + bsmmat04 + bsmmat05 +
bsssci01 + bsssci02 + bsssci03 + bsssci04 + bsssci05
) / 10
) %>%
gather(Parent_Type, Education, c(bsbg07a, bsbg07b)) %>%
select(c(idcntry:idstud, score, Parent_Type, Education)) %>%
filter(!is.na(Education), !is.na(score), Education != 8) -> parent_education
kable(unlist(summary.aov(
aov(formula = score ~ Education,
data = parent_education)
)))| x | |
|---|---|
| Df1 | 1.000000e+00 |
| Df2 | 3.813390e+05 |
| Sum Sq1 | 5.134845e+08 |
| Sum Sq2 | 3.662261e+09 |
| Mean Sq1 | 5.134845e+08 |
| Mean Sq2 | 9.603687e+03 |
| F value1 | 5.346743e+04 |
| F value2 | NA |
| Pr(>F)1 | 0.000000e+00 |
| Pr(>F)2 | NA |
kable(unlist(t.test((parent_education %>% filter(Education == 7))$score,
(parent_education %>% filter(Education != 7))$score,
alternative = "greater"
)))| x | |
|---|---|
| statistic.t | 87.0771358971654 |
| parameter.df | 62288.3374964784 |
| p.value | 0 |
| conf.int1 | 42.1391667756837 |
| conf.int2 | Inf |
| estimate.mean of x | 522.295093618767 |
| estimate.mean of y | 479.344596392976 |
| null.value.difference in means | 0 |
| alternative | greater |
| method | Welch Two Sample t-test |
| data.name | (parent_education %>% filter(Education == 7))\(score and (parent_education %>% filter(Education != 7))\)score |
kable(unlist(t.test((parent_education %>% filter(Education == 1))$score,
(parent_education %>% filter(Education != 1))$score,
alternative = "less"
)))| x | |
|---|---|
| statistic.t | -154.496091364706 |
| parameter.df | 50187.6169610853 |
| p.value | 0 |
| conf.int1 | -Inf |
| conf.int2 | -77.7842254927923 |
| estimate.mean of x | 414.054563368858 |
| estimate.mean of y | 492.675851448884 |
| null.value.difference in means | 0 |
| alternative | less |
| method | Welch Two Sample t-test |
| data.name | (parent_education %>% filter(Education == 1))\(score and (parent_education %>% filter(Education != 1))\)score |
parent_education %>% group_by(Education) %>% summarize(mean_score = mean(score)) -> education_mean_score
parent_education %>% filter(!is.na(Education), !is.na(score)) %>% sample_n(5000) -> pe_sample_5000
hchart(
pe_sample_5000,
type = "scatter",
hcaes(Education, round(score, 2)),
color = hex_to_rgba(x <- "#386cb0", alpha = 0.1)
) %>%
hc_add_series(
data = education_mean_score,
type = "line",
hcaes(Education, round(mean_score, 2)),
color = hex_to_rgba(x <-
"#fdb462")
) %>%
hc_title(text = "Parent's Education and Score Relation") %>%
hc_xAxis(title = list(text = "Education Level")) %>%
hc_yAxis(title = list(text = "Score")) %>%
hc_add_theme(hc_theme_sandsignika())hcboxplot(x = pe_sample_5000$score,
var = pe_sample_5000$Education,
outliers = F) %>%
hc_chart(type = "column") %>%
hc_title(text = "Parent's Education and Score Relation") %>%
hc_xAxis(title = list(text = "Education Level")) %>%
hc_yAxis(title = list(text = "Score")) %>%
hc_add_theme(hc_theme_sandsignika())ggplot(parent_education %>% sample_n(20000),
aes(x = Education, y = score)) +
geom_boxplot(aes(group = Education, y = score, fill = Education)) +
geom_line(data = education_mean_score,
aes(x = Education, y = mean_score),
color = "#fdb462") +
xlab("Education Level") +
ylab("Score") +
ggtitle("Parent's Education and Score Relation")۳. امکانات رفاهی در خانه موجب پیشرفت تحصیلی می گردد.
ابتدا با توجه به تعداد امکانات رفاهی موجود در منزل دانش آموز به آن یک عدد نسبت می دهیم. سپس با آنوا بررسی می کنیم تا ببینیم آیا اصلن امکانات رفاهی تاثیری دارند یا نه. سپس با استفاده از تی تست میانگین افرادی که بیشترین سطح رفاه را دارند با بقیه مقایسه می کنیم و سپس هم میانگین افرادی که کمترین سطح رفاه را دارند. در نهایت مشاهده می کنیم که سطح امکانات رفاهی در خانه موثر است.
BSG %>%
select(idcntry:idstud, bsmmat01:bsssci05 , bsbg06a:bsbg06g) %>%
mutate(
score = (
bsmmat01 + bsmmat02 + bsmmat03 + bsmmat04 + bsmmat05 +
bsssci01 + bsssci02 + bsssci03 + bsssci04 + bsssci05
) / 10
) %>%
mutate(Value = -(bsbg06a + bsbg06b + bsbg06c + bsbg06d + bsbg06e + bsbg06g) + 12) %>%
select(c(idcntry:idstud, score, Value)) %>%
filter(!is.na(Value), !is.na(score)) -> WF
kable(unlist(summary.aov(
aov(formula = score ~ Value,
data = WF)
)))| x | |
|---|---|
| Df1 | 1.000000e+00 |
| Df2 | 2.635220e+05 |
| Sum Sq1 | 2.850287e+08 |
| Sum Sq2 | 2.457311e+09 |
| Mean Sq1 | 2.850287e+08 |
| Mean Sq2 | 9.324882e+03 |
| F value1 | 3.056647e+04 |
| F value2 | NA |
| Pr(>F)1 | 0.000000e+00 |
| Pr(>F)2 | NA |
kable(unlist(t.test((WF %>% filter(Value == 6))$score,
(WF %>% filter(Value != 6))$score,
alternative = "greater"
)))| x | |
|---|---|
| statistic.t | 94.2090151332388 |
| parameter.df | 113416.215913909 |
| p.value | 0 |
| conf.int1 | 39.6923796189657 |
| conf.int2 | Inf |
| estimate.mean of x | 513.28388306715 |
| estimate.mean of y | 472.886168939971 |
| null.value.difference in means | 0 |
| alternative | greater |
| method | Welch Two Sample t-test |
| data.name | (WF %>% filter(Value == 6))\(score and (WF %>% filter(Value != 6))\)score |
kable(unlist(t.test((WF %>% filter(Value == 0))$score,
(WF %>% filter(Value != 0))$score,
alternative = "less"
)))| x | |
|---|---|
| statistic.t | -93.6009381514327 |
| parameter.df | 5649.7767282158 |
| p.value | 0 |
| conf.int1 | -Inf |
| conf.int2 | -104.693426315326 |
| estimate.mean of x | 377.699116972128 |
| estimate.mean of y | 484.265547222443 |
| null.value.difference in means | 0 |
| alternative | less |
| method | Welch Two Sample t-test |
| data.name | (WF %>% filter(Value == 0))\(score and (WF %>% filter(Value != 0))\)score |
WF$Value <- as.character(WF$Value)
WF %>% group_by(Value) %>% summarize(mean_score = mean(score)) %>% filter(!is.na(Value)) -> WF_m
WF_m$Value <- as.numeric(WF_m$Value)
WF$Value <- as.numeric(WF$Value)
WF %>% filter(!is.na(Value), !is.na(score)) %>% sample_n(5000) -> wf_sample_5000
hchart(
WF %>% sample_n(5000),
type = "scatter",
hcaes(Value, round(score, 2)),
color = hex_to_rgba(x <- "#386cb0", alpha = 0.5)
) %>%
hc_add_series(
data = WF_m,
type = "line",
hcaes(Value, round(mean_score, 2)),
color = hex_to_rgba(x <- "#fdb462")
) %>%
hc_title(text = "Home Wellfare and Score Relation") %>%
hc_xAxis(title = list(text = "Home Wellfare Level")) %>%
hc_yAxis(title = list(text = "Score")) %>%
hc_add_theme(hc_theme_sandsignika())hcboxplot(x = wf_sample_5000$score,
var = wf_sample_5000$Value,
outliers = F) %>%
hc_chart(type = "column") %>%
hc_title(text = "Home Wellfare and Score Relation") %>%
hc_xAxis(title = list(text = "Home Wellfare Level")) %>%
hc_yAxis(title = list(text = "Score")) %>%
hc_add_theme(hc_theme_sandsignika())ggplot(WF %>% sample_n(20000), aes(x = Value, y = score)) +
geom_boxplot(aes(group = Value, y = score, fill = Value)) +
geom_line(data = WF_m, aes(x = Value, y = mean_score), color = "#fdb462")+
xlab("Home Wellfare Level") +
ylab("Score") +
ggtitle("Home Wellfare and Score Relation")۴. محیط آرام مدرسه نقش مهمی در پیشرفت تحصیلی دارد.
۵. معلمان با تحصیلات بالاتر یا تجربه بیشتر دانش آموزان موفق تری تربیت می کنند.
۶. پسران در کاربرد هندسه قوی تر هستند.
ابتدا با استفاده از تابعی که پیش از همه ی سوالات نوشته ایم نمرات افراد را بدست می آوریم. به پاسخ کامل نمره ی کامل، به پاسخ نصفه نصف نمره و به پاسخ غلط ۰ امتیاز تعلق گرفته است. همچنین وزن هر سوال حداکثر امتیاز ممکن از آن است. سپس چون نمرات تنها مربوط به کابرد هندسه هستند و سوالات کمی را شامل می شوند نمی توانیم از تی تست استفاده کنیم چون توزیع آن ها نرمال نمی شود. بنابراین از پرمیوتیشن تست استفاده می کنیم و در نهایت مشاهده می کنیم که عملکرد پسر ها در کاربرد هندسه بهتر از دخترهاست.
geo_app_qi <- questions_info_f %>%
filter(`Content Domain` == "Geometry",
`Cognitive Domain` == "Applying")
applying_geometry_questions <- geo_app_qi$`Item ID`
BSA_math <- BSA %>%
select(idcntry:m062120, itsex)
BSA_math %>%
gather(Question, Value , m042182:m062120) -> BSA_math_gathered
BSA_math_gathered %>%
filter(Question %in% applying_geometry_questions,
!is.na(Value),
!is.na(itsex)) -> student_app_geo
marx <-
getMark(student_app_geo %>% select(Question), student_app_geo$Value)
sex_marx <-
data.frame(cbind(sex = as.character(student_app_geo$itsex), marx))
sex_marx$sex <- as.factor(sex_marx$sex)
library(perm) # for Permutation Test
kable(unlist(permTS(
(sex_marx$score * sex_marx$weight) ~ sex_marx$sex,
alternative = "less"
)))| x | |
|---|---|
| statistic.Z | -9.36449093134983 |
| estimate.mean sex_marx\(sex=F - mean sex_marx\)sex=M | -0.0108587393564316 |
| p.value | 3.82088880542399e-21 |
| null.value.mean sex_marx\(sex=F - mean sex_marx\)sex=M | 0 |
| alternative | less |
| method | Permutation Test using Asymptotic Approximation |
| data.name | (sex_marx\(score * sex_marx\)weight) by sex_marx$sex |
| p.values.p.twosided | 7.64177761084799e-21 |
| p.values.p.lte | 3.82088880542399e-21 |
| p.values.p.gte | 1 |
| p.values.p.twosidedAbs | 0 |
student_app_geo <- cbind(student_app_geo, marx)
sex_app_geo <- student_app_geo %>%
group_by(itsex) %>%
summarize(mean_score = weighted.mean(score, weight)) %>%
ungroup()
ggplot(sex_app_geo,
aes(x = itsex, y = mean_score, fill = itsex)) +
geom_bar(position = "dodge", stat = "identity") +
guides(fill = F) +
xlab("Gender") +
ylab("Avg. Score") +
ggtitle("Male vs. Female Performance in Applying Geometry") + coord_flip()sex_app_geo %>% mutate(mean_score = round(mean_score, 3)) %>%
hchart(type = "bar", hcaes(x = itsex, y = mean_score, color = itsex)) %>%
hc_title(text = "Male vs. Female Performance in Applying Geometry") %>%
hc_xAxis(title = list(text = "Gender")) %>%
hc_yAxis(title = list(text = "Avg. Score")) %>%
hc_add_theme(hc_theme_sandsignika())۷. تغذیه دانش آموزان نقش اساسی در یادگیری آنها دارد.
برای پاسخ دادن به این سوال از داده ی مربوط به صبحانه ی دانش آموزان استفاده می کنیم. به این صورت که ایتدا روی ۴ دسته آنووا می زنیم و مشاهده می کنیم که خوردن صبحانه موثر است. سپس برای بررسی تاثیر آن بیشترین و کمترین های صبحانه خوردن را جدا می کنیم و روی آن ها تی تست می زنیم. مشاهده می کنیم که کسانی که صبحانه بیش از بقیه می خورند عملکرد بهتری نسبت به بقیه دارند. ولی کسانی که صبحانه نمی خورند الزامن عملکرد بدتری ندارند(پی ولیو ۰.۰۸ است که برای اثبات کمتر بودن میانگین آن ها کافی نیست.).
## only breakfast exists in data
BSG %>%
select(idcntry:idstud, bsmmat01:bsssci05 , food = bsbg12) %>%
mutate(
food = 4 - food,
score = (
bsmmat01 + bsmmat02 + bsmmat03 + bsmmat04 + bsmmat05 +
bsssci01 + bsssci02 + bsssci03 + bsssci04 + bsssci05
) / 10
) %>%
select(idcntry:idstud, food, score) %>%
filter(!is.na(food), !is.na(score)) -> sb
kable(unlist(summary.aov(
aov(formula = score ~ food,
data = sb)
)))| x | |
|---|---|
| Df1 | 1.000000e+00 |
| Df2 | 2.760780e+05 |
| Sum Sq1 | 2.946775e+07 |
| Sum Sq2 | 2.913609e+09 |
| Mean Sq1 | 2.946775e+07 |
| Mean Sq2 | 1.055357e+04 |
| F value1 | 2.792206e+03 |
| F value2 | NA |
| Pr(>F)1 | 0.000000e+00 |
| Pr(>F)2 | NA |
kable(unlist(t.test((sb %>% filter(food == 3))$score,
(sb %>% filter(food != 3))$score,
alternative = "greater"
)))| x | |
|---|---|
| statistic.t | 50.99563010955 |
| parameter.df | 269579.61804312 |
| p.value | 0 |
| conf.int1 | 19.373009156284 |
| conf.int2 | Inf |
| estimate.mean of x | 490.448372359993 |
| estimate.mean of y | 470.42966155926 |
| null.value.difference in means | 0 |
| alternative | greater |
| method | Welch Two Sample t-test |
| data.name | (sb %>% filter(food == 3))\(score and (sb %>% filter(food != 3))\)score |
kable(unlist(t.test((sb %>% filter(food == 0))$score,
(sb %>% filter(food != 0))$score,
alternative = "less"
)))| x | |
|---|---|
| statistic.t | -1.39097171740675 |
| parameter.df | 46479.2518208822 |
| p.value | 0.0821203309309085 |
| conf.int1 | -Inf |
| conf.int2 | 0.142680564060984 |
| estimate.mean of x | 479.409892318849 |
| estimate.mean of y | 480.191511633823 |
| null.value.difference in means | 0 |
| alternative | less |
| method | Welch Two Sample t-test |
| data.name | (sb %>% filter(food == 0))\(score and (sb %>% filter(food != 0))\)score |
sb$food <- as.character(sb$food)
sb %>% group_by(food) %>% summarize(mean_score = mean(score)) %>% filter(!is.na(food)) -> sb_m
sb_m$food <- as.numeric(sb_m$food)
sb$food <- as.numeric(sb$food)
sb %>% filter(!is.na(food), !is.na(score)) %>% sample_n(5000) -> sb_sample_5000
hchart(
sb_sample_5000,
type = "scatter",
hcaes(food, round(score, 2)),
color = hex_to_rgba(x <- "#386cb0", alpha = 0.5)
) %>%
hc_add_series(
data = sb_m,
type = "line",
hcaes(food, round(mean_score, 2)),
color = hex_to_rgba(x <- "#fdb462")
) %>%
hc_title(text = "Eating Breakfast and Score Relation") %>%
hc_xAxis(title = list(text = "Eating Breakfast")) %>%
hc_yAxis(title = list(text = "Score")) %>%
hc_add_theme(hc_theme_sandsignika())hcboxplot(x = sb_sample_5000$score,
var = sb_sample_5000$food,
outliers = F) %>%
hc_chart(type = "column") %>%
hc_title(text = "Eating Breakfast and Score Relation") %>%
hc_xAxis(title = list(text = "Eating Breakfast")) %>%
hc_yAxis(title = list(text = "Score")) %>%
hc_add_theme(hc_theme_sandsignika())ggplot(sb %>% sample_n(20000), aes(x = food, y = score)) +
geom_boxplot(aes(group = food, y = score, fill = food)) +
geom_line(data = sb_m, aes(x = food, y = mean_score), color = "#fdb462")+
xlab("Eating Breakfast") +
ylab("Score") +
ggtitle("Eating Breakfast and Score Relation") ***
۸. مدارس با امکانات بیشتر دارای عملکرد بهتری می باشند.
۹. علت افت تحصیلی عدم مشارکت در کلاس است.
برای حل این سوال پاسخ دانش آموزان به پرسش مربوط به حضور در کلاس را بررسی می کنیم و بر اساس پاسخ آنان آنان را به ۴ دسته تقسیم می کنیم و روی ۴ دسته آنووا می زنیم. سپس با استفاده از تی تست مشاهده می کنیم که کسانی که حضور در کلاس بیشتری دارند نسبت به بقیه عملکرد بهتری دارند. همچنین کسانی که کمترین سطح حضور در کلاس را دارند هم عملکرد بدتری نسبت به بقیه دارند.
BSG %>%
select(idcntry:idstud, bsmmat01:bsssci05 , presence = bsbg11) %>%
mutate(
score = (
bsmmat01 + bsmmat02 + bsmmat03 + bsmmat04 + bsmmat05 +
bsssci01 + bsssci02 + bsssci03 + bsssci04 + bsssci05
) / 10
) %>%
select(idcntry:idstud, presence, score) %>%
filter(!is.na(presence), !is.na(score)) -> sp
kable(unlist(summary.aov(aov(
formula = score ~ presence,
data = sp
))))| x | |
|---|---|
| Df1 | 1.000000e+00 |
| Df2 | 2.649830e+05 |
| Sum Sq1 | 2.634716e+08 |
| Sum Sq2 | 2.580175e+09 |
| Mean Sq1 | 2.634716e+08 |
| Mean Sq2 | 9.737134e+03 |
| F value1 | 2.705844e+04 |
| F value2 | NA |
| Pr(>F)1 | 0.000000e+00 |
| Pr(>F)2 | NA |
kable(unlist(t.test((sp %>% filter(presence == 4))$score,
(sp %>% filter(presence != 4))$score,
alternative = "greater"
)))| x | |
|---|---|
| statistic.t | 125.952922226406 |
| parameter.df | 212645.476955177 |
| p.value | 0 |
| conf.int1 | 50.1708610795478 |
| conf.int2 | Inf |
| estimate.mean of x | 499.026664285963 |
| estimate.mean of y | 448.191935703561 |
| null.value.difference in means | 0 |
| alternative | greater |
| method | Welch Two Sample t-test |
| data.name | (sp %>% filter(presence == 4))\(score and (sp %>% filter(presence != 4))\)score |
kable(unlist(t.test((sp %>% filter(presence == 1))$score,
(sp %>% filter(presence != 1))$score,
alternative = "less"
)))| x | |
|---|---|
| statistic.t | -149.010036269642 |
| parameter.df | 24825.6743803324 |
| p.value | 0 |
| conf.int1 | -Inf |
| conf.int2 | -98.3720912438415 |
| estimate.mean of x | 387.717950430649 |
| estimate.mean of y | 487.188087995572 |
| null.value.difference in means | 0 |
| alternative | less |
| method | Welch Two Sample t-test |
| data.name | (sp %>% filter(presence == 1))\(score and (sp %>% filter(presence != 1))\)score |
sp$presence <- as.character(sp$presence)
sp %>% group_by(presence) %>% summarize(mean_score = mean(score)) %>% filter(!is.na(presence)) -> sp_m
sp_m$presence <- as.numeric(sp_m$presence)
sp$presence <- as.numeric(sp$presence)
sp %>% filter(!is.na(presence), !is.na(score)) %>% sample_n(5000) -> sp_sample_5000
hchart(
sp_sample_5000,
type = "scatter",
hcaes(presence, round(score, 2)),
color = hex_to_rgba(x <- "#386cb0", alpha = 0.5)
) %>%
hc_add_series(
data = sp_m,
type = "line",
hcaes(presence, round(mean_score, 2)),
color = hex_to_rgba(x <- "#fdb462")
) %>%
hc_title(text = "Presence in Class and Score Relation") %>%
hc_xAxis(title = list(text = "Presence in Class")) %>%
hc_yAxis(title = list(text = "Score")) %>%
hc_add_theme(hc_theme_sandsignika())hcboxplot(x = sp_sample_5000$score,
var = sp_sample_5000$presence,
outliers = F) %>%
hc_chart(type = "column") %>%
hc_title(text = "Presence in Class and Score Relation") %>%
hc_xAxis(title = list(text = "Presence in Class")) %>%
hc_yAxis(title = list(text = "Score")) %>%
hc_add_theme(hc_theme_sandsignika())ggplot(sp %>% sample_n(50000), aes(x = presence, y = score)) +
geom_boxplot(aes(group = presence, y = score, fill = presence)) +
geom_line(data = sp_m,
aes(x = presence, y = mean_score),
color = "#fdb462") +
xlab("Presence in Class") +
ylab("Score") +
ggtitle("Presence in Class and Score Relation")+
guides(fill = F)۱۰. دانش آموزان ایرانی در استدلال قوی تر از کاربرد هستند.
۲ دسته را جدا می کنیم و از آن جایی که معمولن توزیع نمرات از توزیع نرمال پیروی می کند از تی تست برای مقایسه ی میانگین ۲ دسته استفاده می کنیم. پی ولیوی نتایج حدودا ۰.۳ می شود که نتیجه می دهد شواهد کافی برای اثبات اینکه دانش آموزان ایرانی در استدلال قوی تر از کاربرد هستند وجود ندارد.
iran_app_rea <-
BSA %>% select(idcntry:idstud, bsmapp01:bsmrea05, bssapp01:bssrea05) %>%
filter(idcntry == 364) %>%
group_by(idcntry, idbook, idschool, idclass, idstud) %>%
summarize(Applying = mean(c(bsmapp01:bsmapp05, bssapp01:bssapp05)),
Reasoning = mean(c(bsmrea01:bsmrea05, bssrea01:bssrea05))) %>%
ungroup() %>%
gather(Section, Score, Applying, Reasoning)
kable(unlist(t.test((iran_app_rea %>% filter(Section == "Applying"))$Score,
(iran_app_rea %>% filter(Section == "Reasoning"))$Score,
alternative = "greater"
)))| x | |
|---|---|
| statistic.t | 0.453536835906057 |
| parameter.df | 12248.1443007616 |
| p.value | 0.325085129952664 |
| conf.int1 | -1.90984082263893 |
| conf.int2 | Inf |
| estimate.mean of x | 451.805468324821 |
| estimate.mean of y | 451.078463788235 |
| null.value.difference in means | 0 |
| alternative | greater |
| method | Welch Two Sample t-test |
| data.name | (iran_app_rea %>% filter(Section == “Applying”))\(Score and (iran_app_rea %>% filter(Section == "Reasoning"))\)Score |
hcboxplot(x = round(iran_app_rea$Score,2),
var = iran_app_rea$Section,
outliers = F) %>%
hc_chart(type = "column") %>%
hc_title(text = "Iranians in Applying vs Reasoning") %>%
hc_xAxis(title = list(text = "Section")) %>%
hc_yAxis(title = list(text = "Score")) %>%
hc_add_theme(hc_theme_sandsignika())ggplot(iran_app_rea, aes(x = Section, y = Score)) +
geom_boxplot(aes(group = Section, y = Score, fill = Section)) +
xlab("Section") +
ylab("Score") +
ggtitle("Iranians in Applying vs Reasoning")+
guides(fill = F)سه گزاره جالب کشف کنید و ادعای خود را ثابت نمایید.
ادعا می کنیم که برخلاف تصور موجود معلمینی که در روزهای بیشتری از هفته به دانش آموزان تمرین می دهند میانگین عملکرد بدتری نسبت به بقیه دارند. برای بررسی این موضوع از تی تست استفاده می کنیم.
st <- BST %>%
select(c(idcntry:idlink))
teachersM <-
BTM %>%
mutate(assignments = btbm22a) %>%
select(c(idcntry:idlink, assignments))
full_join(teachersM, st) -> st_M
bsa_m <-
BSA %>% select(idcntry:idstud, bsmmat01:bsmmat05) %>%
group_by(idcntry, idbook, idschool, idclass, idstud) %>%
summarize(score = mean(bsmmat01:bsmmat05)) %>%
ungroup()
full_join(st_M, bsa_m) -> sts_M
kable(unlist(t.test((sts_M %>% filter(assignments == 5))$score,
(sts_M %>% filter(assignments != 5))$score,
alternative = "less"
)))| x | |
|---|---|
| statistic.t | -7.09823162186523 |
| parameter.df | 134291.412657605 |
| p.value | 6.34926740090916e-13 |
| conf.int1 | -Inf |
| conf.int2 | -2.54666611992219 |
| estimate.mean of x | 476.303468078156 |
| estimate.mean of y | 479.618269218304 |
| null.value.difference in means | 0 |
| alternative | less |
| method | Welch Two Sample t-test |
| data.name | (sts_M %>% filter(assignments == 5))\(score and (sts_M %>% filter(assignments != 5))\)score |
sts_M$assignments <- as.character(sts_M$assignments)
sts_M %>%
group_by(assignments) %>%
summarize(mean_score = mean(score)) %>% filter(!is.na(assignments)) -> sts_M_m
sts_M_m$assignments <- as.numeric(sts_M_m$assignments)
sts_M$assignments <- as.numeric(sts_M$assignments)
sts_M %>% filter(!is.na(assignments), !is.na(score)) %>% sample_n(5000) -> sts_M_sample_5000
hchart(
sts_M_sample_5000,
type = "scatter",
hcaes(assignments, round(score, 2)),
color = hex_to_rgba(x <- "#386cb0", alpha = 0.1)
) %>%
hc_add_series(
data = sts_M_m,
type = "line",
hcaes(assignments, round(mean_score, 2)),
color = hex_to_rgba(x <- "#fdb462", alpha = 1)
) %>%
hc_title(text = "Homework Frequency and Score Relation") %>%
hc_xAxis(title = list(text = "Homework Frequency")) %>%
hc_yAxis(title = list(text = "Score")) %>%
hc_add_theme(hc_theme_sandsignika())hcboxplot(x = sts_M_sample_5000$score,
var = sts_M_sample_5000$assignments,
outliers = F) %>%
hc_chart(type = "column") %>%
hc_title(text = "Homework Frequency and Score Relation") %>%
hc_xAxis(title = list(text = "Homework Frequency")) %>%
hc_yAxis(title = list(text = "Score")) %>%
hc_add_theme(hc_theme_sandsignika())ggplot(sts_M %>% filter(!is.na(assignments), !is.na(score)) %>% sample_n(50000),
aes(x = assignments, y = score)) +
geom_boxplot(aes(group = assignments, y = score, fill = assignments)) +
geom_line(data = sts_M_m, aes(x = assignments, y = mean_score), color = "#fdb462")+
xlab("Homework Frequency") +
ylab("Score") +
ggtitle("Homework Frequency and Score Relation")+
guides(fill = F)در پرسشنامه قسمتی مربوط به گذراندن کلاس در خارج از محیط مدرسه بود و همچنین پرسشی هم از کسانی که در خارج از مدرسه کلاس می گذرانند شده بود که با چه هدفی در خارج از مدرسه کلاس می گذرانند. در این قسمت میانگین عملکرد دانش آموزانی که کلن کلاس بیرون از مدرسه نمی روند و کسانی را که ادعا کرده اند برای ممتاز بودن در کلاس های خارج از مدرسه شرکت می کنند را مقایسه می کنیم و با استفاده از تی تست مشاهده می کنیم که میانگین کسانی که کللن در کلاس های خارج از مدرسه شرکت نمی کنند بهتر است.
## Taking classes to excel in class
BSG %>%
select(idcntry:idstud, bsmmat01:bsssci05 , bsbm39aa) %>%
filter(!is.na(bsbm39aa)) %>%
filter(bsbm39aa != 2) %>%
mutate(
score = (
bsmmat01 + bsmmat02 + bsmmat03 + bsmmat04 + bsmmat05
) / 5,
to_excel = (bsbm39aa == 1)
) %>%
select(c(idcntry:idstud, score, to_excel)) %>%
filter(!is.na(to_excel), !is.na(score)) -> math_class_purpose
kable(unlist(t.test((math_class_purpose %>% filter(to_excel == T))$score,
(math_class_purpose %>% filter(to_excel == F))$score,
alternative = "less")))| x | |
|---|---|
| statistic.t | -82.0164324715587 |
| parameter.df | 114198.574425878 |
| p.value | 0 |
| conf.int1 | -Inf |
| conf.int2 | -40.5893755655582 |
| estimate.mean of x | 456.929509645799 |
| estimate.mean of y | 498.349578539189 |
| null.value.difference in means | 0 |
| alternative | less |
| method | Welch Two Sample t-test |
| data.name | (math_class_purpose %>% filter(to_excel == T))\(score and (math_class_purpose %>% filter(to_excel == F))\)score |
math_class_purpose_mean <- math_class_purpose%>%
group_by(to_excel) %>%
summarize(mean_score = mean(score))
ggplot(math_class_purpose_mean,
aes(x = to_excel, y = mean_score, fill = to_excel)) +
geom_bar(position = "dodge", stat = "identity") +
guides(fill = F) +
xlab("To Excel and not Taken") +
ylab("Avg. Score") +
ggtitle("To Excel and not Taken and Score") + coord_flip()math_class_purpose_mean %>% mutate(mean_score = round(mean_score, 2)) %>%
hchart(type = "bar", hcaes(x = as.factor(to_excel), y = mean_score, color = as.factor(to_excel))) %>%
hc_title(text = "Score ~ To Excel and not Taken") %>%
hc_xAxis(title = list(text = "To Excel and not Taken")) %>%
hc_yAxis(title = list(text = "Avg. Score")) %>%
hc_add_theme(hc_theme_sandsignika())در این قسمت هم میانگین عملکرد مهاجرین را با میانگین عملکرد غیرمهاجرین از طریق تی تست مقایسه می کنیم و مشاهده می کنیم که مهاجرین به طور میانگین عملکرد بهتری در آزمون دارند.
## Comparing immigrants who have immigrated earlier to others
BSG %>%
select(idcntry:idstud, bsmmat01:bsssci05 , bsbg10a) %>%
filter(!is.na(bsbg10a)) %>%
mutate(
score = (bsmmat01 + bsmmat02 + bsmmat03 + bsmmat04 + bsmmat05) / 5,
immigrated = (bsbg10a == 2)
) %>%
select(c(idcntry:idstud, score, immigrated)) %>%
filter(!is.na(immigrated), !is.na(score)) -> immigration_score
kable(unlist(t.test((immigration_score %>% filter(immigrated == T))$score,
(immigration_score %>% filter(immigrated == F))$score,
alternative = "greater"
)))| x | |
|---|---|
| statistic.t | 33.437236974174 |
| parameter.df | 39567.5108480879 |
| p.value | 4.65533097277504e-242 |
| conf.int1 | 19.5619658256152 |
| conf.int2 | Inf |
| estimate.mean of x | 495.795120030461 |
| estimate.mean of y | 475.221045033097 |
| null.value.difference in means | 0 |
| alternative | greater |
| method | Welch Two Sample t-test |
| data.name | (immigration_score %>% filter(immigrated == T))\(score and (immigration_score %>% filter(immigrated == F))\)score |
immigration_score_mean <- immigration_score %>%
group_by(immigrated) %>%
summarize(mean_score = mean(score))
ggplot(
immigration_score_mean,
aes(x = immigrated, y = mean_score, fill = immigrated)
) +
geom_bar(position = "dodge", stat = "identity") +
guides(fill = F) +
xlab("Immigrated") +
ylab("Avg. Score") +
ggtitle("Immigration and Score") + coord_flip()immigration_score_mean %>% mutate(mean_score = round(mean_score, 2)) %>%
hchart(type = "bar", hcaes(
x = as.factor(immigrated),
y = mean_score,
color = as.factor(immigrated)
)) %>%
hc_title(text = "Immigration and Score") %>%
hc_xAxis(title = list(text = "Immigrated")) %>%
hc_yAxis(title = list(text = "Avg. Score")) %>%
hc_add_theme(hc_theme_sandsignika())